﻿#VisualFreeBasic_Form#  Version=5.6.2
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=
WinStyle=WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_VISIBLE,WS_BORDER,WS_CAPTION,WS_SYSMENU,WS_MAXIMIZEBOX,WS_MINIMIZEBOX,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=
Caption=VFB5启动画面例题
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=420
Height=290
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False


[AllCode]
Sub huahua(aa As Long) ' 画启动动画
   
   Dim As Long  x, y, a ,w , h ,b
   Dim dc As hDC
   Dim rr As rect
   dim HWND_STARTUP as HWND = form1.hwnd
   dc = GetDC(HWND_STARTUP)
   
   FF_Control_GetSize(HWND_STARTUP, w, h)
   dim Compiler as String = "Compiler 1.07.1 gcc 9.2"  'GetFileStr("X:\FB文件库\VisualFreeBasic5\Compile\info.txt")
   
   Dim tFont as HFONT, s as SIZE
   Dim oFont as HGDIOBJ
   dim vfbm as long = &HE700,mt as long
   dim vfbc as long = &HE710
   '// 创建一个兼容的位图
   dim m_Bmp As HBITMAP = CreateCompatibleBitmap(DC, w, h)
   '// 创建兼容的设备上下文
   dim m_Dc As hDC = CreateCompatibleDC(DC)
   '// 将位图选择到兼容的设备上下文中
   DeleteObject SelectObject(m_Dc, m_Bmp)
   SetBkMode m_Dc, 1 '设置这个后，画上的字是透明的
   dim dt as Long = DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
   dim banben as String = "5.5.1" ' app.FileMajor & "." & app.FileMinor & "." & app.FileRevision

   Do
      DrawFrame m_Dc, 0, 0, w, h, &HFFFFFF
      SetTextColor m_Dc, &H416C00
      tFont = AfxCreateFont("iconfont", 250, -1)
      SelectObject(m_Dc, tFont)
      SetRect @rr, 0, 0, w, AfxScaleY(220)
      DrawTextW(m_Dc, Cast(WString ptr, @vfbm), -1, @rr, dt)
      SetTextColor m_Dc, &HFF0000
      DrawTextW(m_Dc, Cast(WString ptr, @vfbc), -1, @rr, dt)
      DeleteObject tFont
      tFont = AfxCreateFont("Arial Black", 20, -1)  '
      SelectObject(m_Dc, tFont)
      SetTextColor m_Dc,&H742CAF
      SetRect @rr,AfxScaleX(80), AfxScaleY(140),AfxScaleX(250), AfxScaleY(175)      
      DrawTextA(m_Dc, StrPtr(banben), Len(banben), @rr, dt)
      DeleteObject tFont
      tFont = AfxCreateFont("Arial Black", 32, -1)  '
      SelectObject(m_Dc, tFont)
      SetTextColor m_Dc,0
      SetRect @rr,0, AfxScaleY(170),w, AfxScaleY(210)      
      DrawTextA(m_Dc, @"VisualFreeBasic", 15, @rr, dt)
      DeleteObject tFont
      tFont = AfxCreateFont("Arial Black", 20, -1)  '
      SelectObject(m_Dc, tFont)
      SetTextColor m_Dc,&H326DA3
      SetRect @rr,0, AfxScaleY(210),w, AfxScaleY(250)      
      DrawTextA(m_Dc,StrPtr(Compiler), Len(Compiler), @rr, dt)
      DeleteObject tFont  
      tFont = AfxCreateFont("微软雅黑", 20, -1,FW_BOLD)  '
      SelectObject(m_Dc, tFont)
      SetTextColor m_Dc,&H813451
      SetRect @rr,0, AfxScaleY(250),w, AfxScaleY(280)      
      DrawTextA(m_Dc,@"勇 芳 软 件 工 作 室", -1, @rr, dt)
      DeleteObject tFont           
            BitBlt DC, 0, 0, w, h, m_Dc, 0, 0, SrcCopy '将内存DC，输出到控件
      
      If IsWindow(HWND_STARTUP) = 0 Then Exit Do
      if mt = 0 then
         vfbm += 1
         if vfbm > &HE70A then
            mt = 1
            vfbm = &HE709
         end if
      else
         vfbm -= 1
         if vfbm < &HE700 then
            mt = 0
            vfbm = &HE701
         end if
      end if
      vfbc += 1 : if vfbc > &HE714 then vfbc = &HE710
      Sleep_ 50
      
      
   Loop
   
   DeleteObject m_Bmp
   DeleteDC m_Dc
   ReleaseDC HWND_STARTUP, DC
   
End Sub


Sub Form1_WM_Create(hWndForm As hWnd,UserData As Integer)  '完成创建窗口及所有的控件后，此时窗口还未显示。注：自定义消息里 WM_Create 此时还未创建控件和初始赋值。
   Dim sst As String =  GetResourceStr("FONT_ICONFONT", App.HINSTANCE)
   '   Dim As Long uu  = AddFontResourceExA(StrPtr(sst), FR_PRIVATE, 0)
   Dim  As Long uu
    AddFontMemResourceEx(StrPtr(sst),len(sst),0,@uu )
   Print uu
   Threaddetach ThreadCreate(Cast(Any Ptr, @huahua), 0) '经典调用方法
   
End Sub



Function Form1_WM_Close(hWndForm As hWnd) As LResult  '即将关闭窗口，返回非0可阻止关闭

    Function = 0 '根据自己需要修改
End Function

